home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / contrib / xmu / GNU / xmu-menu.el < prev   
Encoding:
Text File  |  1991-10-06  |  5.8 KB  |  181 lines
  1. ; -*-Emacs-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         xmu-menu.el
  5. ; RCS:          $Header: $
  6. ; Description:  Elisp Interface to a WINTERP-based menu server...
  7. ; Author:       Richard Hess, Consilium.
  8. ;        Updated for gnuvo and other fixes by Niels Mayer.
  9. ; Created:      Sat Oct  5 23:24:49 1991
  10. ; Modified:     Sat Oct  5 23:43:11 1991 (Niels Mayer) mayer@hplnpm
  11. ; Language:     Emacs-Lisp
  12. ; Package:      N/A
  13. ; Status:       X11r5 contrib tape release
  14. ;
  15. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  16. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  17. ;
  18. ; Permission to use, copy, modify, distribute, and sell this software and its
  19. ; documentation for any purpose is hereby granted without fee, provided that
  20. ; the above copyright notice appear in all copies and that both that
  21. ; copyright notice and this permission notice appear in supporting
  22. ; documentation, and that the name of Hewlett-Packard and David Betz not be
  23. ; used in advertising or publicity pertaining to distribution of the software
  24. ; without specific, written prior permission.  Hewlett-Packard and David Betz
  25. ; make no representations about the suitability of this software for any
  26. ; purpose. It is provided "as is" without express or implied warranty.
  27. ;
  28. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29.  
  30. ; +---------------------------------------------------------------------------
  31. ;  WHO:    Richard Hess                    CORP:   Consilium
  32. ;  TITLE:  Staff Engineer                  VOICE:  [415] 691-6342
  33. ;      [ X-SWAT Team:  Special Projects ]  USNAIL: 640 Clyde Court
  34. ;  UUCP:   ...!uunet!cimshop!rhess                 Mountain View, CA 94043
  35. ; +---------------------------------------------------------------------------
  36.  
  37. (provide 'xmu-menu)
  38.  
  39. (defvar xmu-output "/tmp/.xmu_output" 
  40.   "[ NEW ]:  the output file from the WINTERP-based menu server...")
  41.  
  42. (defvar xmu-socket "/tmp/.xmu_server"
  43.   "[ NEW ]:  the socket name used by the WINTERP-based menu server...") 
  44.  
  45. (defvar xmu-client "wl"
  46.   "[ NEW ]:  the name of the client program that sends lisp expressions to the
  47. WINTERP-based menu server...") 
  48.  
  49. (defvar xmu-client-args nil
  50.   "[ NEW ]:  the default arguments sent to 'xmu-client'...")
  51.  
  52. (defvar xmu-error nil
  53.   "[ NEW ]:  the error flag from the last menu request... [ string ]")
  54.  
  55. (defvar xmu-errors '((":NoLock" "menu server currently active")
  56.              (":NoMenu" "invalid menu key")
  57.              (":NoPick" "menu selection aborted"))
  58.   "[ NEW ]:  the list of valid menu server errors...")
  59.  
  60.  
  61. ;; --------------------------------------------------------------[ xmu_popup ]
  62.  
  63. (cond
  64.  ;; special version of xmu_popup for gnuvo (based on 18.44.2)
  65.  ((string= emacs-version "18.44.2")    
  66. (defun xmu_popup (key &optional xloc yloc)
  67.   "[ NEW ]:  elisp interface to a WINTERP-based menu server..."
  68.   (interactive)
  69.   (message "")
  70.   (if (not (file-exists-p xmu-socket))
  71.       (progn (message "Xmu::NoServer  [ no active menu server ]")
  72.          (setq xmu-error ":NoServer")
  73.          (format ""))
  74.     (let ((xbuf  (current-buffer))
  75.       (xargs (format
  76.           "(xmu_popup %s %s %s 'GNU_cbk)"
  77.           key
  78.           xloc
  79.           yloc))
  80.       (buf (find-file-noshow xmu-output))
  81.       pick
  82.       )
  83.       (setq xmu-error nil)
  84.       (apply 'start-process "xmu-menu" nil
  85.          xmu-client
  86.          "-f"
  87.          xmu-socket
  88.          (append xmu-client-args (list xargs)))
  89.       (while (verify-visited-file-modtime buf) (sleep-for 1))
  90.       (while (eq (nth 7 (file-attributes xmu-output)) 0) (sleep-for 1))
  91.       (kill-buffer buf)
  92.       (setq buf (find-file-noshow xmu-output))
  93.       (set-buffer buf)
  94.       (setq pick (substring (buffer-string) 0 -1))
  95.       (kill-buffer buf)
  96.       (set-buffer xbuf)
  97.       (let* ((ecode (assoc pick xmu-errors))
  98.          )
  99.     (if ecode
  100.         (progn (setq xmu-error pick)
  101.            (message (format "Xmu:%s  [ %s ]" pick (car (cdr ecode))))
  102.            (format ""))
  103.       pick))
  104.       ))
  105.   )
  106. )
  107.  
  108.   ;; normal gnuemacs version of xmu_popup
  109.   (t
  110. (defun xmu_popup (key &optional xloc yloc)
  111.   "[ NEW ]:  elisp interface to a WINTERP-based menu server..."
  112.   (interactive)
  113.   (message "")
  114.   (if (not (file-exists-p xmu-socket))
  115.       (progn (message "Xmu::NoServer  [ no active menu server ]")
  116.          (setq xmu-error ":NoServer")
  117.          (format ""))
  118.     (let ((xbuf  (current-buffer))
  119.       (xargs (format
  120.           "(xmu_popup %s %s %s 'GNU_cbk)"
  121.           key
  122.           xloc
  123.           yloc))
  124.       (buf (find-file-noselect xmu-output))
  125.       pick
  126.       )
  127.       (setq xmu-error nil)
  128.       (apply 'start-process "xmu-menu" nil
  129.          xmu-client
  130.          "-f"
  131.          xmu-socket
  132.          (append xmu-client-args (list xargs)))
  133.       (while (verify-visited-file-modtime buf) (sleep-for 1))
  134.       (while (eq (nth 7 (file-attributes xmu-output)) 0) (sleep-for 1))
  135.       (kill-buffer buf)
  136.       (setq buf (find-file-noselect xmu-output))
  137.       (set-buffer buf)
  138.       (setq pick (substring (buffer-string) 0 -1))
  139.       (kill-buffer buf)
  140.       (set-buffer xbuf)
  141.       (let* ((ecode (assoc pick xmu-errors))
  142.          )
  143.     (if ecode
  144.         (progn (setq xmu-error pick)
  145.            (message (format "Xmu:%s  [ %s ]" pick (car (cdr ecode))))
  146.            (format ""))
  147.       pick))
  148.       ))
  149.   )
  150. )
  151. )
  152.  
  153. ;; ---------------------------------------------------------------[ xmu_menu ]
  154.  
  155. (defun xmu_menu (key heading def &optional note)
  156.   "[ NEW ]:  elisp interface to a WINTERP-based menu server..."
  157.   (interactive)
  158.   (message "")
  159.   (if (not note)
  160.       (setq note "::GNU"))
  161.   (if (not (file-exists-p xmu-socket))
  162.       (progn (message "Xmu::NoServer  [ no active menu server ]")
  163.          (setq xmu-error ":NoServer")
  164.          (format ""))
  165.     (let ((xargs (format
  166.           "(xmu_menu %s \"%s\" (quote %s) \"%s\")"
  167.           key
  168.           heading
  169.           def
  170.           note)))
  171.       (setq xmu-error nil)
  172.       (apply 'start-process "xmu-menu" nil
  173.          xmu-client
  174.          "-f"
  175.          xmu-socket
  176.          (append xmu-client-args (list xargs)))
  177.       ))
  178.   )
  179.  
  180. ;; ----------------------------------------------------------------------<eof>
  181.